VERSION 5.00
Begin VB.UserControl VCTSummaryCtrl 
   BackColor       =   &H00FFFFFF&
   ClientHeight    =   5280
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   11625
   ScaleHeight     =   5280
   ScaleWidth      =   11625
   Begin VB.CommandButton DemoButton 
      Appearance      =   0  'Flat
      BackColor       =   &H00C0FFFF&
      Caption         =   "Demographic Summary"
      BeginProperty Font 
         Name            =   "Arial Narrow"
         Size            =   20.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   735
      Left            =   60
      Style           =   1  'Graphical
      TabIndex        =   3
      Top             =   0
      Width           =   3975
   End
   Begin VB.CommandButton RiskButton 
      Appearance      =   0  'Flat
      Caption         =   "Risk Assessment"
      BeginProperty Font 
         Name            =   "Arial Narrow"
         Size            =   20.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   735
      Left            =   4020
      Style           =   1  'Graphical
      TabIndex        =   2
      Top             =   0
      Width           =   3075
   End
   Begin VB.CommandButton PartnerButton 
      Appearance      =   0  'Flat
      Caption         =   "Recent Partners"
      BeginProperty Font 
         Name            =   "Arial Narrow"
         Size            =   20.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   735
      Left            =   7080
      Style           =   1  'Graphical
      TabIndex        =   1
      Top             =   0
      Width           =   2955
   End
   Begin VB.CommandButton PlanButton 
      Appearance      =   0  'Flat
      Caption         =   "Plan"
      BeginProperty Font 
         Name            =   "Arial Narrow"
         Size            =   20.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   735
      Left            =   10020
      Style           =   1  'Graphical
      TabIndex        =   0
      Top             =   0
      Width           =   1335
   End
   Begin VCT.ClientPlanCtrl ClientPlanCtrl1 
      Height          =   3855
      Left            =   0
      TabIndex        =   8
      Top             =   1140
      Width           =   11415
      _ExtentX        =   20135
      _ExtentY        =   6800
   End
   Begin VCT.SexPartnerDetailCtrl SexPartnerDetailCtrl1 
      Height          =   3855
      Left            =   0
      TabIndex        =   4
      Top             =   1020
      Width           =   11595
      _ExtentX        =   20452
      _ExtentY        =   6800
   End
   Begin VCT.ClientSexHistCtrl ClientSexHistCtrl1 
      Height          =   3915
      Left            =   0
      TabIndex        =   5
      Top             =   900
      Width           =   11595
      _ExtentX        =   20452
      _ExtentY        =   6906
   End
   Begin VCT.ClientDemoCtrl ClientDemoCtrl1 
      Height          =   3855
      Left            =   0
      TabIndex        =   6
      Top             =   780
      Width           =   11535
      _ExtentX        =   20346
      _ExtentY        =   6800
   End
   Begin VB.Label TestResultLabel 
      BackColor       =   &H00FFFFFF&
      Caption         =   "Client Tested:"
      BeginProperty Font 
         Name            =   "Arial Narrow"
         Size            =   15.75
         Charset         =   0
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   435
      Left            =   420
      TabIndex        =   7
      Top             =   4800
      Width           =   7815
   End
End
Attribute VB_Name = "VCTSummaryCtrl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private Sub DemoButton_Click()
   DemoButton.BackColor = RGB(255, 255, 192)
   RiskButton.BackColor = RGB(192, 192, 192)
   PartnerButton.BackColor = RGB(192, 192, 192)
   PlanButton.BackColor = RGB(192, 192, 192)
   ClientDemoCtrl1.Visible = True
   ClientSexHistCtrl1.Visible = False
   SexPartnerDetailCtrl1.Visible = False
   ClientPlanCtrl1.Visible = False
'   ClientDemoCtrl1.SetFocus
End Sub

Private Sub PartnerButton_Click()
   DemoButton.BackColor = RGB(192, 192, 192)
   RiskButton.BackColor = RGB(192, 192, 192)
   PartnerButton.BackColor = RGB(255, 255, 192)
   PlanButton.BackColor = RGB(192, 192, 192)
   ClientDemoCtrl1.Visible = False
   ClientSexHistCtrl1.Visible = False
   SexPartnerDetailCtrl1.Visible = True
   ClientPlanCtrl1.Visible = False
   SexPartnerDetailCtrl1.SetFocus
   SexPartnerDetailCtrl1.SetFocus
End Sub

Private Sub PlanButton_Click()
   DemoButton.BackColor = RGB(192, 192, 192)
   RiskButton.BackColor = RGB(192, 192, 192)
   PartnerButton.BackColor = RGB(192, 192, 192)
   PlanButton.BackColor = RGB(255, 255, 192)
   ClientDemoCtrl1.Visible = False
   ClientSexHistCtrl1.Visible = False
   SexPartnerDetailCtrl1.Visible = False
   ClientPlanCtrl1.Visible = True
   ClientPlanCtrl1.SetFocus
End Sub

Private Sub RiskButton_Click()
   DemoButton.BackColor = RGB(192, 192, 192)
   RiskButton.BackColor = RGB(255, 255, 192)
   PartnerButton.BackColor = RGB(192, 192, 192)
   PlanButton.BackColor = RGB(192, 192, 192)
   ClientDemoCtrl1.Visible = False
   ClientSexHistCtrl1.Visible = True
   SexPartnerDetailCtrl1.Visible = False
   ClientPlanCtrl1.Visible = False
   ClientSexHistCtrl1.SetFocus
End Sub

Private Sub UserControl_Initialize()
   UpdateClientDetails
End Sub

Public Sub UpdateClientDetails()

   Dim I As Integer

'   'Initialize  global variables
'   DISCOR = ""
'   RRPLAN0 = "1" 'I changed this
'   RRPLAN1 = "0"
'   RRPLAN2 = "0"
'   RRPLAN3 = "0"
'   RRPLAN4 = "0"
'   RRPLAN5 = "0"
'   RRPLAN6 = "0"
'   RRPLAN7 = "0"
'   RRPLAN8 = "0"
'   RRPLAN9 = "0"
'   RRPLAN10 = "0"
'   RRPLAN11 = "0"
'   RRPLAN12 = "0"
'   RRPLAN99 = "0"
'   REFTO0 = "1" 'I changed this
'   REFTO1 = "0"
'   REFTO2 = "0"
'   REFTO3 = "0"
'   REFTO4 = "0"
'   REFTO5 = "0"
'   REFTO6 = "0"
'   REFTO7 = "0"
'   REFTO8 = "0"
'   REFTO9 = "0"
'   REFTO10 = "0"
'   REFTO11 = "0"
'   REFTO98 = "0"
'   REFTO99 = "0"
'   COUNSELD = ""
'   GAVETEST = ""
'   GAVERESU = ""
'   COUNCOND = -1
   
   DemoButton_Click
   
   If ConnectString <> "" And VISITID <> 0 Then
   
   
      'Get the client's details from the database
      CnUser.Open ConnectString
      Cmd.CommandText = "SELECT CLNTCODE, SEX, SESSTYPE, HIV, COUPCODE" _
                     & " FROM   client" _
                     & " WHERE VISITID = " & VISITID
      Cmd.CommandType = adCmdText
      Cmd.ActiveConnection = CnUser
      RsUser.Open Cmd, , adOpenStatic
         CLIENTCO = RsUser(0)
         Sex = RsUser(1)
         SESSTYPE = RsUser(2)
         HIV = RsUser(3)
         COUPCODE = RsUser(4)
      RsUser.Close
      CnUser.Close
   
      ClientDemoCtrl1.Visible = True
      ClientSexHistCtrl1.Visible = False
      SexPartnerDetailCtrl1.Visible = False
      ClientPlanCtrl1.Visible = False
      ClientDemoCtrl1.Top = 680
      SexPartnerDetailCtrl1.Top = 680
      ClientSexHistCtrl1.Top = 680
      ClientPlanCtrl1.Top = 680
      ClientDemoCtrl1.SetShape (0)
      ClientSexHistCtrl1.SetShape (0)
      SexPartnerDetailCtrl1.SetShape (0)
      ClientPlanCtrl1.SetShape (0)
      
      CurrPartner = 0 'need this to prevent the control from crashing
      
      'Get the record corresponding to the VisitID parameter
      CnUser.Open ConnectString
      Cmd.CommandText = "SELECT REGION, DISTRICT, SITE, VDATE, RETURNV, CLNTCODE, NEWCODE, SESSTYPE, COUPCODE, PARTCODE, COUPTYPE, COUNCODE, SEX, AGE, RESID, GROUPSES, EMPLOYED, OCCUPAT, EDUEXPE, MARSTAT, MARTYPE, MARHIST, KNOWUS1, KNOWUS2, KNOWUS3, KNOWUS4, KNOWUS5, KNOWUS6, KNOWUS7, KNOWUS8, KNOWUS98, KNOWUS99, REFERBY, REASHERE, VISITTYP" _
                     & " FROM   client" _
                     & " WHERE VISITID = " & VISITID
      Cmd.CommandType = adCmdText
      Cmd.ActiveConnection = CnUser
      RsUser.Open Cmd, , adOpenStatic
      
      REGION = RsUser(0)
      DISTRICT = RsUser(1)
      SITE = Mid(RsUser(2), 2, 2) 'this does not work with the 2-digit codes
      SITE = TrimAll(RsUser(2)) 'this should work
      VDATE = RsUser(3)
      RETURNV = RsUser(4)
      CLIENTCO = RsUser(5)
      NEWCODE = RsUser(6)
      SESSTYPE = RsUser(7)
      COUPCODE = RsUser(8)
      PARTCODE = RsUser(9)
      COUPTYPE = RsUser(10)
      COUNCODE = RsUser(11)
      Sex = RsUser(12)
      Age = RsUser(13)
      RESCLASS = RsUser(14)
      GROUPSES = RsUser(15)
      EMPLOYED = RsUser(16)
      OCCUPAT = RsUser(17)
      EDUEXPE = RsUser(18)
      MARSTAT = RsUser(19)
      MARTYPE = RsUser(20)
      MARHIST = RsUser(21)
      KNOWUS1 = RsUser(22)
      KNOWUS2 = RsUser(23)
      KNOWUS3 = RsUser(24)
      KNOWUS4 = RsUser(25)
      KNOWUS5 = RsUser(26)
      KNOWUS6 = RsUser(27)
      KNOWUS7 = RsUser(28)
      KNOWUS8 = RsUser(29)
      KNOWUS98 = RsUser(30)
      KNOWUS99 = RsUser(31)
      REFERBY = RsUser(32)
      REASHERE = RsUser(33)
      
      'Use this to determine if the rest of the record should be printer or not
      VISITTYP = RsUser(34)
         
      RsUser.Close
      CnUser.Close
      ClientDemoCtrl1.UpdateData
         
      'Get the client sexual history data
      CnUser.Open ConnectString
      Cmd.CommandText = "SELECT PRTESTED, TMONTH, TYEAR, PRTESITE, EVERHAD, LIFEPART, SMONTH, SYEAR, EVERAPED, PREG, TRANSFUS, STISYMPT, TBSYMPT, REFERRED" _
                     & " FROM   client" _
                     & " WHERE VISITID = " & VISITID
      Cmd.CommandType = adCmdText
      Cmd.ActiveConnection = CnUser
      RsUser.Open Cmd, , adOpenStatic
      
      PRTESTED = RsUser(0)
      TMONTH = RsUser(1)
      TYEAR = RsUser(2)
      PRTESITE = RsUser(3)
      EVERHAD = RsUser(4)
      LIFEPART = RsUser(5)
      SMONTH = RsUser(6)
      SYEAR = RsUser(7)
      EVERAPED = RsUser(8)
      PREG = RsUser(9)
      TRANSFUS = RsUser(10)
      STISYMPT = RsUser(11)
      TBSYMPT = RsUser(12)
      REFERRED = RsUser(13)
      
      RsUser.Close
      CnUser.Close
      'ClientSexHistCtrl1.UpdateData
      
      'Get the history for the 4 most recent sexual partners
      CnUser.Open ConnectString
      Cmd.CommandText = "SELECT P1TYPE, P1NEW, P1STATUS, P1LTSTMO, P1LTSTYR, P1FPMETH, P1CONUSE, P1CONLST, P2TYPE, P2NEW, P2STATUS, P2LTSTMO, P2LTSTYR, P2FPMETH, P2CONUSE, P2CONLST, P3TYPE, P3NEW, P3STATUS, P3LTSTMO, P3LTSTYR, P3FPMETH, P3CONUSE, P3CONLST, P4TYPE, P4NEW, P4STATUS, P4LTSTMO, P4LTSTYR, P4FPMETH, P4CONUSE, P4CONLST" _
                     & " FROM   client" _
                     & " WHERE VISITID = " & VISITID
      Cmd.CommandType = adCmdText
      Cmd.ActiveConnection = CnUser
      RsUser.Open Cmd, , adOpenStatic
      
      PTYPE(0) = RsUser(0)
      PTYPE(1) = RsUser(8)
      PTYPE(2) = RsUser(16)
      PTYPE(3) = RsUser(24)
      PNEW(0) = RsUser(1)
      PNEW(1) = RsUser(9)
      PNEW(2) = RsUser(17)
      PNEW(3) = RsUser(25)
      PSTATUS(0) = RsUser(2)
      PSTATUS(1) = RsUser(10)
      PSTATUS(2) = RsUser(18)
      PSTATUS(3) = RsUser(26)
      PLTSTMO(0) = RsUser(3)
      PLTSTMO(1) = RsUser(11)
      PLTSTMO(2) = RsUser(19)
      PLTSTMO(3) = RsUser(27)
      PLTSTYR(0) = RsUser(4)
      PLTSTYR(1) = RsUser(12)
      PLTSTYR(2) = RsUser(20)
      PLTSTYR(3) = RsUser(28)
      PFPMETH(0) = RsUser(5)
      PFPMETH(1) = RsUser(13)
      PFPMETH(2) = RsUser(21)
      PFPMETH(3) = RsUser(29)
      PCONUSE(0) = RsUser(6)
      PCONUSE(1) = RsUser(14)
      PCONUSE(2) = RsUser(22)
      PCONUSE(3) = RsUser(30)
      PCONLST(0) = RsUser(7)
      PCONLST(1) = RsUser(15)
      PCONLST(2) = RsUser(23)
      PCONLST(3) = RsUser(31)
      
      RsUser.Close
      CnUser.Close
      PART6MO = 0
      For I = 0 To 3
         If PTYPE(I) <> "" Then
           PART6MO = PART6MO + 1
         End If
      Next I
      If PART6MO > 0 Then
         RecentPartnerDetails = "See Recent Partners Tab"
      Else
         RecentPartnerDetails = "N/A"
         PartnerButton.Enabled = False
      End If
      
      ClientSexHistCtrl1.UpdateData
      SexPartnerDetailCtrl1.UpdateData
      
      'Get HIV Status
      CnUser.Open ConnectString
      Cmd.CommandText = "SELECT HIV, TIMEPOST" _
                     & " FROM   client" _
                     & " WHERE VISITID = " & VISITID
      Cmd.CommandType = adCmdText
      Cmd.ActiveConnection = CnUser
      RsUser.Open Cmd, , adOpenStatic
      HIV = RsUser(0)
      If IsNull(RsUser(1)) Then
         TIMEPOST = ""
      Else
        TIMEPOST = RsUser(1)
      End If
      RsUser.Close
      CnUser.Close
         
      Select Case HIV
         Case ""
            TestResultLabel.Caption = "Client HIV Test Result: Missing"
         Case "00"
            TestResultLabel.Caption = "Client HIV Test Result: Negative"
         Case "01"
            TestResultLabel.Caption = "Client HIV Test Result: Positive"
            TestResultLabel.ForeColor = vbRed
         Case "97"
            TestResultLabel.Caption = "Client HIV Test Result: Inconclusive"
            TestResultLabel.ForeColor = vbRed
         Case "98"
            TestResultLabel.Caption = "Client HIV Test Result: N/A"
         Case Else
            TestResultLabel.Caption = "Client HIV Test Result: ERROR"
      End Select

      'Get the plan details
      If TIMEPOST <> "" Then
         CnUser.Open ConnectString
         Cmd.CommandText = "SELECT HIV, DISCOR, RRPLAN0, RRPLAN1, RRPLAN2, RRPLAN3, RRPLAN4, RRPLAN5, RRPLAN6, RRPLAN7, RRPLAN8, RRPLAN9, RRPLAN10, RRPLAN11, RRPLAN99, REFTO0, REFTO1, REFTO2, REFTO3, REFTO4, REFTO5, REFTO6, REFTO7, REFTO8, REFTO98, REFTO99, COUNSELD, GAVERESU, COUNCOND" _
                        & " FROM   client" _
                        & " WHERE VISITID = " & VISITID
         Cmd.CommandType = adCmdText
         Cmd.ActiveConnection = CnUser
         RsUser.Open Cmd, , adOpenStatic
         
         HIV = RsUser(0)
         DISCOR = RsUser(1)
         RRPLAN0 = RsUser(2)
         RRPLAN1 = RsUser(3)
         RRPLAN2 = RsUser(4)
         RRPLAN3 = RsUser(5)
         RRPLAN4 = RsUser(6)
         RRPLAN5 = RsUser(7)
         RRPLAN6 = RsUser(8)
         RRPLAN7 = RsUser(9)
         RRPLAN8 = RsUser(10)
         RRPLAN9 = RsUser(11)
         RRPLAN10 = RsUser(12)
         RRPLAN11 = RsUser(13)
         RRPLAN99 = RsUser(14)
         REFTO0 = RsUser(15)
         REFTO1 = RsUser(16)
         REFTO2 = RsUser(17)
         REFTO3 = RsUser(18)
         REFTO4 = RsUser(19)
         REFTO5 = RsUser(20)
         REFTO6 = RsUser(21)
         REFTO7 = RsUser(22)
         REFTO8 = RsUser(23)
         REFT98 = RsUser(24)
         REFTO99 = RsUser(25)
         COUNSELD = RsUser(26)
         GAVERESU = RsUser(27)
         COUNCOND = RsUser(28)
         
         RsUser.Close
         CnUser.Close
      
         'Get the extra variables for Lighthouse
         If ORGANIZATION = "LIGHTHOUSE" Then
            CnUser.Open ConnectString
            Cmd.CommandText = "SELECT REFTO9, REFTO10, REFTO11, RRPLAN12" _
                           & " FROM   client" _
                           & " WHERE VISITID = " & VISITID
            Cmd.CommandType = adCmdText
            Cmd.ActiveConnection = CnUser
            RsUser.Open Cmd, , adOpenStatic
            REFTO9 = RsUser(0)
            REFTO10 = RsUser(1)
            REFTO11 = RsUser(2)
            RRPLAN12 = RsUser(3)
            RsUser.Close
            CnUser.Close
         Else
            REFTO9 = "0"
            REFTO10 = "0"
            REFTO11 = "0"
            RRPLAN12 = "0"
         End If
         ClientPlanCtrl1.UpdateData
      Else
         PlanButton.Enabled = False
      End If
   End If
End Sub



